home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #3 / Amiga Plus CD - 2002 - No. 03.iso / AmiSoft / Dev / E / Eviled.lha / hltext.e < prev    next >
Encoding:
Text File  |  2003-01-29  |  15.9 KB  |  421 lines
  1. OPT MODULE
  2.  
  3. MODULE 'graphics/rastport'
  4.    
  5. PROC ifu(str,l)
  6.    DEF c
  7.    IF str[1] < "a" THEN RETURN NIL
  8.    c := str[]
  9.    SELECT 128 OF c
  10.      CASE "A"
  11.         IF StrCmp(str, 'Abs',l)  THEN RETURN STRLEN
  12.      CASE "B"
  13.         IF StrCmp(str, 'Bounds',l) THEN RETURN STRLEN
  14.         IF StrCmp(str, 'Box',l)    THEN RETURN STRLEN
  15.      CASE "C"
  16.         IF StrCmp(str, 'Char',l) THEN RETURN STRLEN    
  17.         IF StrCmp(str, 'CtrlC',l) THEN RETURN STRLEN   
  18.         IF StrCmp(str, 'Colour',l) THEN RETURN STRLEN  
  19.         IF StrCmp(str, 'CloseW',l) THEN RETURN STRLEN  
  20.         IF StrCmp(str, 'CloseS',l) THEN RETURN STRLEN  
  21.      CASE "D"
  22.         IF StrCmp(str, 'Dispose',l) THEN RETURN STRLEN    
  23.         IF StrCmp(str, 'DiposeLink',l) THEN RETURN STRLEN 
  24.         IF StrCmp(str, 'Div',l) THEN RETURN STRLEN        
  25.      CASE "E"
  26.         IF StrCmp(str, 'Eor',l) THEN RETURN STRLEN        
  27.         IF StrCmp(str, 'EstrLen',l) THEN RETURN STRLEN    
  28.         IF StrCmp(str, 'Even',l) THEN RETURN STRLEN       
  29.         IF StrCmp(str, 'Exists',l) THEN RETURN STRLEN  
  30.         IF StrCmp(str, 'Eval',l) THEN RETURN STRLEN     
  31.      CASE "F"
  32.         IF StrCmp(str, 'FastNew',l) THEN RETURN STRLEN    
  33.         IF StrCmp(str, 'FastDispose',l) THEN RETURN STRLEN
  34.         IF StrCmp(str, 'FastDiposeList',l) THEN RETURN STRLEN 
  35.         IF StrCmp(str, 'Forward',l) THEN RETURN STRLEN        
  36.         IF StrCmp(str, 'FileLength',l) THEN RETURN STRLEN  
  37.         IF StrCmp(str, 'ForAll',l) THEN RETURN STRLEN      
  38.         IF StrCmp(str, 'FreeStack',l) THEN RETURN STRLEN   
  39.         IF StrCmp(str, 'Ftan',l) THEN RETURN STRLEN        
  40.         IF StrCmp(str, 'Fabs',l) THEN RETURN STRLEN        
  41.         IF StrCmp(str, 'Facos',l) THEN RETURN STRLEN       
  42.         IF StrCmp(str, 'Fsin',l) THEN RETURN STRLEN        
  43.         IF StrCmp(str, 'Fsincos',l) THEN RETURN STRLEN     
  44.         IF StrCmp(str, 'Fcosh',l) THEN RETURN STRLEN       
  45.         IF StrCmp(str, 'Ftanh',l) THEN RETURN STRLEN       
  46.         IF StrCmp(str, 'Fexp',l) THEN RETURN STRLEN        
  47.         IF StrCmp(str, 'Ffieee',l) THEN RETURN STRLEN      
  48.         IF StrCmp(str, 'Ffloor',l) THEN RETURN STRLEN      
  49.         IF StrCmp(str, 'Flog',l) THEN RETURN STRLEN        
  50.         IF StrCmp(str, 'Flog10',l) THEN RETURN STRLEN      
  51.         IF StrCmp(str, 'Fpow',l) THEN RETURN STRLEN        
  52.         IF StrCmp(str, 'Fsinh',l) THEN RETURN STRLEN       
  53.         IF StrCmp(str, 'Fsqrt',l) THEN RETURN STRLEN       
  54.         IF StrCmp(str, 'Ftieee',l) THEN RETURN STRLEN      
  55.         IF StrCmp(str, 'Fcos',l) THEN RETURN STRLEN        
  56.      CASE "H"
  57.         IF StrCmp(str, 'Hbox',l) THEN RETURN STRLEN     
  58.      CASE "I"
  59.         IF StrCmp(str, 'Inp',l) THEN RETURN STRLEN      
  60.         IF StrCmp(str, 'Int',l) THEN RETURN STRLEN      
  61.         IF StrCmp(str, 'InStr',l) THEN RETURN STRLEN    
  62.      CASE "K"
  63.         IF StrCmp(str, 'KickVersion',l) THEN RETURN STRLEN
  64.      CASE "L"
  65.         IF StrCmp(str, 'LeftMouse',l) THEN RETURN STRLEN  
  66.         IF StrCmp(str, 'List',l) THEN RETURN STRLEN       
  67.         IF StrCmp(str, 'Long',l) THEN RETURN STRLEN       
  68.         IF StrCmp(str, 'ListItem',l) THEN RETURN STRLEN   
  69.         IF StrCmp(str, 'ListLen',l) THEN RETURN STRLEN    
  70.         IF StrCmp(str, 'ListMax',l) THEN RETURN STRLEN    
  71.         IF StrCmp(str, 'Link',l) THEN RETURN STRLEN       
  72.         IF StrCmp(str, 'LowerStr',l) THEN RETURN STRLEN   
  73.         IF StrCmp(str, 'ListCmp',l) THEN RETURN STRLEN    
  74.         IF StrCmp(str, 'ListCopy',l) THEN RETURN STRLEN   
  75.         IF StrCmp(str, 'ListAdd',l) THEN RETURN STRLEN    
  76.         IF StrCmp(str, 'Line',l) THEN RETURN STRLEN     
  77.      CASE "M"
  78.         IF StrCmp(str, 'Max',l) THEN RETURN STRLEN      
  79.         IF StrCmp(str, 'Min',l) THEN RETURN STRLEN      
  80.         IF StrCmp(str, 'Mul',l) THEN RETURN STRLEN      
  81.         IF StrCmp(str, 'Mod',l) THEN RETURN STRLEN      
  82.         IF StrCmp(str, 'Mouse',l) THEN RETURN STRLEN  
  83.         IF StrCmp(str, 'MouseX',l) THEN RETURN STRLEN   
  84.         IF StrCmp(str, 'MouseY',l) THEN RETURN STRLEN   
  85.         IF StrCmp(str, 'MidStr',l) THEN RETURN STRLEN   
  86.         IF StrCmp(str, 'MapList',l) THEN RETURN STRLEN  
  87.         IF StrCmp(str, 'MsgCode',l) THEN RETURN STRLEN  
  88.         IF StrCmp(str, 'MsgQualifier',l) THEN RETURN STRLEN
  89.         IF StrCmp(str, 'MsgIAddr',l) THEN RETURN STRLEN    
  90.      CASE "N"
  91.         IF StrCmp(str, 'New',l) THEN RETURN STRLEN 
  92.         IF StrCmp(str, 'NewR',l) THEN RETURN STRLEN  
  93.         IF StrCmp(str, 'NewM',l) THEN RETURN STRLEN        
  94.         IF StrCmp(str, 'Next',l) THEN RETURN STRLEN 
  95.         IF StrCmp(str, 'Not',l) THEN RETURN STRLEN        
  96.      CASE "O"
  97.         IF StrCmp(str, 'Odd',l) THEN RETURN STRLEN         
  98.         IF StrCmp(str, 'Out',l) THEN RETURN STRLEN         
  99.         IF StrCmp(str, 'OpenW',l) THEN RETURN STRLEN 
  100.         IF StrCmp(str, 'OpenS',l) THEN RETURN STRLEN 
  101.         IF StrCmp(str, 'ObjectName',l) THEN RETURN STRLEN
  102.         IF StrCmp(str, 'ObjectSize',l) THEN RETURN STRLEN
  103.      CASE "P"
  104.         IF StrCmp(str, 'PutLong',l) THEN RETURN STRLEN   
  105.         IF StrCmp(str, 'PutInt',l) THEN RETURN STRLEN    
  106.         IF StrCmp(str, 'PutChar',l) THEN RETURN STRLEN   
  107.         IF StrCmp(str, 'PrintF',l) THEN RETURN STRLEN    
  108.         IF StrCmp(str, 'Plot',l) THEN RETURN STRLEN      
  109.      CASE "R"
  110.         IF StrCmp(str, 'ReadStr',l) THEN RETURN STRLEN   
  111.         IF StrCmp(str, 'RightStr',l) THEN RETURN STRLEN   
  112.         IF StrCmp(str, 'RealVal',l) THEN RETURN STRLEN    
  113.         IF StrCmp(str, 'RealF',l) THEN RETURN STRLEN      
  114.         IF StrCmp(str, 'Rnd',l) THEN RETURN STRLEN        
  115.         IF StrCmp(str, 'RndQ',l) THEN RETURN STRLEN 
  116.         IF StrCmp(str, 'ReThrow',l) THEN RETURN STRLEN  
  117.         IF StrCmp(str, 'Raise',l) THEN RETURN STRLEN       
  118.      CASE "S"
  119.         IF StrCmp(str, 'String',l) THEN RETURN STRLEN     
  120.         IF StrCmp(str, 'StrMax',l) THEN RETURN STRLEN     
  121.         IF StrCmp(str, 'Shl',l) THEN RETURN STRLEN        
  122.         IF StrCmp(str, 'Shr',l) THEN RETURN STRLEN        
  123.         IF StrCmp(str, 'StrCmp',l) THEN RETURN STRLEN     
  124.         IF StrCmp(str, 'StrCopy',l) THEN RETURN STRLEN    
  125.         IF StrCmp(str, 'StrAdd',l) THEN RETURN STRLEN     
  126.         IF StrCmp(str, 'Sign',l) THEN RETURN STRLEN       
  127.         IF StrCmp(str, 'StrLen',l) THEN RETURN STRLEN     
  128.         IF StrCmp(str, 'StringF',l) THEN RETURN STRLEN     
  129.         IF StrCmp(str, 'SelectList',l) THEN RETURN STRLEN 
  130.         IF StrCmp(str, 'SetStr',l) THEN RETURN STRLEN     
  131.         IF StrCmp(str, 'SetList',l) THEN RETURN STRLEN    
  132.         IF StrCmp(str, 'SetColour',l) THEN RETURN STRLEN  
  133.         IF StrCmp(str, 'SetStdRast',l) THEN RETURN STRLEN 
  134.      CASE "T"
  135.         IF StrCmp(str, 'TrimStr',l) THEN RETURN STRLEN
  136.         IF StrCmp(str, 'Throw',l) THEN RETURN STRLEN   
  137.         IF StrCmp(str, 'TextF',l) THEN RETURN STRLEN    
  138.      CASE "U"
  139.         IF StrCmp(str, 'UpperStr',l) THEN RETURN STRLEN   
  140.      CASE "V"
  141.         IF StrCmp(str, 'Val',l) THEN RETURN STRLEN        
  142.      CASE "W"
  143.         IF StrCmp(str, 'WaitIMessage',l) THEN RETURN STRLEN 
  144.         IF StrCmp(str, 'WriteF',l) THEN RETURN STRLEN
  145.         IF StrCmp(str, 'WaitLeftMouse',l) THEN RETURN STRLEN
  146.      ENDSELECT
  147.   
  148. ENDPROC NIL
  149.  
  150. PROC ikw(str,l)
  151.    DEF c
  152.  
  153.    IF str[1] > "Z" THEN RETURN NIL
  154.  
  155.    c := str[]
  156.  
  157.    SELECT 128 OF c
  158.    CASE "A"
  159.          IF StrCmp(str, 'ALL',l) THEN RETURN STRLEN, 5
  160.          IF StrCmp(str, 'AND',l) THEN RETURN STRLEN, 5
  161.          IF StrCmp(str, 'ARRAY',l) THEN RETURN STRLEN, 5
  162.    CASE "B"
  163.          IF StrCmp(str, 'BUT',l) THEN RETURN STRLEN, 5
  164.    CASE "C"
  165.          IF StrCmp(str, 'CONST',l) THEN RETURN STRLEN, 5
  166.          IF StrCmp(str, 'CHAR',l) THEN RETURN STRLEN, 5
  167.          IF StrCmp(str, 'CASE',l) THEN RETURN STRLEN, 7
  168.    CASE "D"
  169.          IF StrCmp(str, 'DEF',l) THEN RETURN STRLEN, 5
  170.          IF StrCmp(str, 'DIR',l) THEN RETURN STRLEN, 5
  171.          IF StrCmp(str, 'DO',l) THEN RETURN STRLEN, 5
  172.          IF StrCmp(str, 'DEFAULT',l) THEN RETURN STRLEN, 7
  173.    CASE "E"
  174.          IF StrCmp(str, 'EXCEPT',l) THEN RETURN STRLEN, 5
  175.          IF StrCmp(str, 'END',l) THEN RETURN STRLEN, 5
  176.          IF StrCmp(str, 'ENDPROC',l) THEN RETURN STRLEN, 5
  177.          IF StrCmp(str, 'EXPORT',l) THEN RETURN STRLEN, 5
  178.          IF StrCmp(str, 'ENUM',l) THEN RETURN STRLEN, 5
  179.          IF StrCmp(str, 'ENDOBJECT',l) THEN RETURN STRLEN, 5
  180.          IF StrCmp(str, 'ELSE',l) THEN RETURN STRLEN, 7
  181.          IF StrCmp(str, 'ELSEIF',l) THEN RETURN STRLEN, 7
  182.          IF StrCmp(str, 'ENDIF',l) THEN RETURN STRLEN, 7
  183.          IF StrCmp(str, 'ENDWHILE',l) THEN RETURN STRLEN, 6
  184.          IF StrCmp(str, 'ENDLOOP',l) THEN RETURN STRLEN, 6
  185.          IF StrCmp(str, 'ENDFOR',l) THEN RETURN STRLEN, 6
  186.          IF StrCmp(str, 'EMPTY',l) THEN RETURN STRLEN, 5
  187.          IF StrCmp(str, 'ENDSELECT',l) THEN RETURN STRLEN, 7
  188.          IF StrCmp(str, 'EXIT',l) THEN RETURN STRLEN, 7
  189.    CASE "F"
  190.          IF StrCmp(str, 'FOR',l) THEN RETURN STRLEN, 6
  191.          IF StrCmp(str, 'FALSE',l) THEN RETURN STRLEN, 5
  192.    CASE "G"
  193.    CASE "H"
  194.          IF StrCmp(str, 'HANDLE',l) THEN RETURN STRLEN, 5
  195.    CASE "I"
  196.          IF StrCmp(str, 'IS',l) THEN RETURN STRLEN, 5
  197.          IF StrCmp(str, 'INT',l) THEN RETURN STRLEN, 5
  198.          IF StrCmp(str, 'IF',l) THEN RETURN STRLEN, 7
  199.    CASE "J"
  200.          IF StrCmp(str, 'JUMP',l) THEN RETURN STRLEN, 7
  201.    CASE "K"
  202.    CASE "L"
  203.          IF StrCmp(str, 'LIST',l) THEN RETURN STRLEN, 5
  204.          IF StrCmp(str, 'LONG',l) THEN RETURN STRLEN, 5
  205.          IF StrCmp(str, 'LOOP',l) THEN RETURN STRLEN, 6
  206.          IF StrCmp(str, 'LIBRARY',l) THEN RETURN STRLEN, 5
  207.    CASE "M"
  208.          IF StrCmp(str, 'MODULE',l) THEN RETURN STRLEN, 5
  209.    CASE "N"
  210.          IF StrCmp(str, 'NEW',l) THEN RETURN STRLEN, 5
  211.          IF StrCmp(str, 'NIL',l) THEN RETURN STRLEN, 5
  212.          IF StrCmp(str, 'NEWFILE',l) THEN RETURN STRLEN, 5
  213.    CASE "O"
  214.          IF StrCmp(str, 'OBJECT',l) THEN RETURN STRLEN, 5
  215.          IF StrCmp(str, 'OPT',l) THEN RETURN STRLEN, 5
  216.          IF StrCmp(str, 'OF',l) THEN RETURN STRLEN, 5
  217.          IF StrCmp(str, 'OR',l) THEN RETURN STRLEN, 5
  218.          IF StrCmp(str, 'OLDFILE',l) THEN RETURN STRLEN, 5
  219.    CASE "P"
  220.          IF StrCmp(str, 'PROC',l) THEN RETURN STRLEN, 5
  221.          IF StrCmp(str, 'PTR',l) THEN RETURN STRLEN, 5
  222.          IF StrCmp(str, 'PRIVATE',l) THEN RETURN STRLEN, 5
  223.          IF StrCmp(str, 'PUBLIC',l) THEN RETURN STRLEN, 5
  224.          IF StrCmp(str, 'PREPROCESS',l) THEN RETURN STRLEN, 5
  225.    CASE "Q"
  226.    CASE "R"
  227.          IF StrCmp(str, 'REG',l) THEN RETURN STRLEN, 5
  228.          IF StrCmp(str, 'REPEAT',l) THEN RETURN STRLEN, 6
  229.          IF StrCmp(str, 'READWRITE',l) THEN RETURN STRLEN, 5
  230.          IF StrCmp(str, 'RETURN',l) THEN RETURN STRLEN, 7
  231.          IF StrCmp(str, 'RAISE',l) THEN RETURN STRLEN, 5
  232.    CASE "S"
  233.          IF StrCmp(str, 'SET',l) THEN RETURN STRLEN, 5
  234.          IF StrCmp(str, 'SELECT',l) THEN RETURN STRLEN, 7
  235.          IF StrCmp(str, 'STRLEN, 5',l) THEN RETURN STRLEN, 5
  236.          IF StrCmp(str, 'SIZEOF',l) THEN RETURN STRLEN, 5
  237.          IF StrCmp(str, 'STEP',l) THEN RETURN STRLEN, 5
  238.          IF StrCmp(str, 'STRING',l) THEN RETURN STRLEN, 5
  239.          IF StrCmp(str, 'STACK',l) THEN RETURN STRLEN, 5
  240.          IF StrCmp(str, 'SUPER',l) THEN RETURN STRLEN, 5
  241.    CASE "T"
  242.          IF StrCmp(str, 'TO',l) THEN RETURN STRLEN, 5
  243.          IF StrCmp(str, 'THEN',l) THEN RETURN STRLEN, 7
  244.          IF StrCmp(str, 'TRUE',l) THEN RETURN STRLEN, 5
  245.    CASE "U"
  246.          IF StrCmp(str, 'UNTIL',l) THEN RETURN STRLEN, 6
  247.    CASE "V"
  248.    CASE "W"
  249.          IF StrCmp(str, 'WHILE',l) THEN RETURN STRLEN, 6
  250.    CASE "X"
  251.    CASE "Y"
  252.    CASE "Z"
  253.    ENDSELECT
  254.  
  255. ENDPROC NIL
  256.  
  257. PROC getLabelLen(str)
  258.    DEF c:REG, i:REG
  259.    i := 0
  260.    WHILE (c := str[i])
  261.       SELECT 128 OF c
  262.       CASE "0" TO "9", "A" TO "Z", "a" TO "z", "_"
  263.          i++
  264.       DEFAULT
  265.          RETURN i
  266.       ENDSELECT
  267.    ENDWHILE
  268. ENDPROC i
  269.  
  270. EXPORT PROC hlText(rp:PTR TO rastport, str, len, pentable:PTR TO CHAR)
  271.    DEF llen, s[1000]:STRING, oldx, oldy, x, y, slen, oldfg, oldbg, c, t, t2
  272.    -> keep this in vars for faster access..
  273.    DEF y2, txwidth, xmin1
  274.  
  275.    oldx := rp.cp_x
  276.    oldy := rp.cp_y 
  277.    oldfg := rp.fgpen
  278.    oldbg := rp.bgpen
  279.  
  280.    x := oldx
  281.    y := oldy 
  282.  
  283.    
  284.    SetDrMd(rp, 1)
  285.    
  286.    StrCopy(s, str, len)
  287.    IF len = 0 THEN SetStr(s, 0) -> crap EC !
  288.  
  289.    y2 := y-1+rp.txheight
  290.    txwidth := rp.txwidth
  291.  
  292.    WHILE (c := s[])
  293.       SELECT 128 OF c
  294.       CASE "A" TO "Z" 
  295.          llen := getLabelLen(s)
  296.          IF s[llen] = "("
  297.             IF ifu(s,llen) = llen -> if true, it is ifunc 
  298.                SetAPen(rp,pentable[9]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  299.                x := x + (txwidth*llen)
  300.                s := s + llen   
  301.             ELSE -> system function
  302.                SetAPen(rp,pentable[8]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  303.                x := x + (txwidth*llen)
  304.                s := s + llen 
  305.             ENDIF
  306.          ELSE -> not function
  307.             t, t2 := ikw(s,llen)
  308.             IF t = llen -> if true, it is keyword
  309.                SetAPen(rp,pentable[t2]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  310.                x := x + (txwidth*llen)
  311.                s := s + llen 
  312.             ELSE -> constant
  313.                SetAPen(rp,pentable[4]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  314.                x := x + (txwidth*llen)
  315.                s := s + llen 
  316.             ENDIF
  317.          ENDIF
  318.       CASE "a" TO "z"
  319.          llen := getLabelLen(s)
  320.          IF s[llen] = "("
  321.             SetAPen(rp,pentable[11]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  322.             x := x + (txwidth*llen)
  323.             s := s + llen
  324.          ELSE
  325.             SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  326.             x := x + (txwidth*llen)
  327.             s := s + llen 
  328.          ENDIF
  329.       CASE "#"
  330.          SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  331.          x := x + txwidth
  332.          s++
  333.          llen := getLabelLen(s)
  334.          SetAPen(rp,pentable[12]) ; RectFill(rp,x,y,x+(txwidth*llen)-1,y2)
  335.          x := x + (txwidth*llen)
  336.          s := s + llen
  337.       CASE "(", ")", "[", "]", "{", "}"
  338.          SetAPen(rp,pentable[3]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  339.          x := x + txwidth
  340.          s++
  341.       CASE "\q"
  342.          t := InStr(s+1, '\q')
  343.          IF t <> -1
  344.             t := t + 2
  345.             SetAPen(rp,pentable[10]) ; RectFill(rp,x,y,x+(txwidth*t)-1,y2)
  346.          ELSE
  347.             t := 1
  348.             SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  349.          ENDIF
  350.          x := x + (txwidth*t)
  351.          s := s + t  
  352.       CASE "\a"
  353.          t := InStr(s+1, '\a')
  354.          IF t <> -1
  355.             t := t + 2
  356.             SetAPen(rp,pentable[10]) ; RectFill(rp,x,y,x+(txwidth*t)-1,y2)
  357.          ELSE
  358.             t := 1
  359.             SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  360.          ENDIF
  361.          x := x + (txwidth*t)
  362.          s := s + t 
  363.       CASE "-"
  364.          IF s[1] = ">"
  365.             slen := StrLen(s)
  366.             SetAPen(rp,pentable[2]) ; RectFill(rp,x,y,x+(txwidth*slen)-1,y2)
  367.             x := x + (txwidth*slen)
  368.             s := s + slen
  369.          ELSE
  370.             SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  371.             x := x + txwidth
  372.             s++
  373.          ENDIF 
  374.       CASE "/"
  375.          IF s[1] = "*"
  376.             t := Abs(InStr(s+2, '*/')) + 4
  377.             SetAPen(rp,pentable[2]) ; RectFill(rp,x,y,x+(txwidth*t)-1,y2)
  378.             x := x + (txwidth*t)
  379.             s := s + t
  380.          ELSE
  381.             SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  382.             x := x + txwidth
  383.             s++
  384.          ENDIF
  385.       ->CASE "$", "%", "1" TO "9", "0"
  386.       ->   t, llen := Val(s)
  387.       ->   IF llen
  388.       ->      Box(x,y,x+(txwidth*llen)-1,y2, pentable[4])
  389.       ->      x := x + (txwidth*llen)
  390.       ->      s := s + llen
  391.       ->   ELSE
  392.       ->      Box(x,y,x-1+txwidth,y2, pentable[1])
  393.       ->      x := x + txwidth
  394.       ->      s++
  395.       ->   ENDIF    
  396.       DEFAULT
  397.          SetAPen(rp,pentable[1]) ; RectFill(rp,x,y,x-1+txwidth,y2)
  398.          x := x + txwidth
  399.          s++         
  400.       ENDSELECT
  401.    ENDWHILE
  402.        
  403.    rp.cp_x := oldx
  404.    rp.cp_y := oldy + rp.txbaseline
  405.    rp.fgpen := oldbg -> !
  406.    rp.bgpen := oldfg
  407.  
  408.    SetDrMd(rp, 4)
  409.  
  410.    Text(rp,str,len)
  411.  
  412.    c := rp.fgpen -> !
  413.    rp.fgpen := rp.bgpen
  414.    rp.bgpen := c
  415.  
  416.    SetDrMd(rp,1)
  417.  
  418.    rp.cp_x := oldx
  419.    rp.cp_y := oldy + rp.txheight
  420.  
  421. ENDPROC